home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #1 / Ham Radio 2000.iso / ham2000 / misc / worldmap / mapvu20 / trigcalc.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-01-11  |  3.4 KB  |  105 lines
  1. Program trigcalc; { precalculate trig tables for MapView }
  2. { tables calculated will be Ln(ArcTan(p2 * x + p1)) and Sin(x)               }
  3. { for x = 0..90, in steps of 0.01, where p2 = Pi/360, p1 = Pi/4              }
  4. { Optional command line argument: /4 or /6 (Default is /6):                  }
  5. { /2 : format is standard TurboPascal 6 byte reals; output file is TRIG2.BIN }
  6. { /3 : format is IEEE 4 byte reals for 80x87 use;   output file is TRIG3.BIN }
  7. { Freeware by TapirSoft Gisbert W.Selke, 18 Dec 1988. TurboPascal 5.0        }
  8.  
  9. {$R-,S-,I-,D-,F-,V-,B-,N+,E+,L+ }
  10. {$M 65520,0,480000 }
  11.  
  12.   Const out2name = 'TRIG2.BIN';
  13.         out3name = 'TRIG3.BIN';
  14.         maxangle = 9000;
  15.         max1merc = 8500;
  16.  
  17.   Type table2 = Array [0..maxangle] Of real;
  18.        table3 = Array [0..maxangle] Of single;
  19.  
  20.   Var trigf2 : File Of table2;
  21.       trigf3 : File Of table3;
  22.       y2 : table2;
  23.       y3 : table3 Absolute y2;
  24.       x, p1, p2 : double;
  25.       i : word;
  26.       outname : string;
  27.       ieee : boolean;
  28.  
  29.   Procedure init;
  30.   { read command line                                                        }
  31.     Var t : string;
  32.   Begin                                                               { init }
  33.     ieee := False;
  34.     t := ParamStr(1);
  35.     If t <> '' Then
  36.     Begin
  37.       If (Length(t) = 2) And (t[1] In ['/','-']) And (t[2] In ['2','3']) Then
  38.                                                            ieee := t[2] = '3'
  39.       Else
  40.       Begin
  41.         writeln('Usage: trigcalc [/2 | /3] to produce TRIG2.BIN or TRIG3.BIN');
  42.         writeln('       (TurboPascal 6-byte reals or IEEE 4-byte reals)');
  43.         writeln('       Default is /2.');
  44.         writeln('       See MAPVIEW.DOC for details.');
  45.         Halt(1);
  46.       End;
  47.     End;
  48.     If ieee Then outname := out3name Else outname := out2name;
  49.   End;                                                                { init }
  50.  
  51. Begin                                                                 { main }
  52.   init;
  53. writeln('TRIGCALC 1.1  --  Freeware by TapirSoft Gisbert W.Selke, 19 Dec 1988');
  54.   If ieee Then
  55.   Begin
  56.     Assign(trigf3,outname);
  57.     Rewrite(trigf3);
  58.   End Else
  59.   Begin
  60.     Assign(trigf2,outname);
  61.     Rewrite(trigf2);
  62.   End;
  63.   If IOResult <> 0 Then
  64.   Begin
  65.     writeln('Cannot open ',outname);
  66.     Halt(2);
  67.   End;
  68.   write('          Calculating Ln(Tan(x))',#13);
  69.   p1 := Pi / 4.0;
  70.   p2 := Pi / 36000.0;
  71.   For i := 0 To max1merc Do
  72.   Begin
  73.     x := i*p2 + p1;
  74.     If ieee Then y3[i] := Ln(Sin(x)/Cos(x))
  75.             Else y2[i] := Ln(Sin(x)/Cos(x));
  76.     If Lo(i) = 0 Then write(i,#13);
  77.   End;
  78.   If ieee Then For i := Succ(max1merc) To maxangle Do y3[i] := i*0.01
  79.           Else For i := Succ(max1merc) To maxangle Do y2[i] := i*0.01;
  80.   writeln(maxangle);
  81.   If ieee Then write(trigf3,y3) Else write(trigf2,y2);
  82.   If IOResult <> 0 Then
  83.   Begin
  84.     writeln('Cannot write to ',outname);
  85.     Halt(3);
  86.   End;
  87.   write('          Calculating Sin(x)',#13);
  88.   p2 := Pi / 18000.0;
  89.   For i := 0 To maxangle Do
  90.   Begin
  91.     If ieee Then y3[i] := Sin(i*p2)
  92.             Else y2[i] := Sin(i*p2);
  93.     If Lo(i) = 0 Then write(i,#13);
  94.   End;
  95.   writeln(maxangle);
  96.   If ieee Then write(trigf3,y3) Else write(trigf2,y2);
  97.   If ieee Then Close(trigf3) Else Close(trigf2);
  98.   If IOResult <> 0 Then
  99.   Begin
  100.     writeln('Cannot write to ',outname);
  101.     Halt(3);
  102.   End;
  103.   writeln('Done.');
  104. End.                                                                  { main }
  105.